VIBES STUDY 2 ANALYSIS — STIMULUS LEVEL — MILLENIAL PINK PLANTS B0-0
ANONYMIZED
2024-08-07
In VISUALIZATION VIBES project Study 2, participants completed an attitutde eliciation survey, asking questions about their attitude toward (5) stimulus images (data visualizations). Each participant was randomly assigned to one of 6 stimulus blocks, each containing 1 image from each of (4) pseudo-categories (ranging from most abstract to most figural). Each participant started by responding to questions for a single ‘common’ stimulus (that is thus super-powered as it was seen by all participants). Two participant recruitment pools were used: Prolific, with a smaller set of participants recruited from Tumblr (to replicate and compare survey results to Study 1 interviews with participants sourced from Tumblr).
This notebook contains code to replicate quantitative analysis of data from Study 2 reported in the CHI submission. Note that due to limited space, we were unable to report results for all stimulus blocks, and all possible analyses. A separate set of R notebooks are included in the supplementary materials that document analysis of the other blocks not reported here.
This notebook includes analysis and exploration of the data
set at the stimulus level FOR the single common stimulus,
B0-0
1 SETUP
We start by importing data files previously wrangled in
0_VIBES_S2_wrangling.Rmd.
1.1 Import Data
############## IMPORT REFERENCE FILES
ref_stimuli <- readRDS("data/input/REFERENCE/ref_stimuli.rds")
ref_surveys <- readRDS("data/input/REFERENCE/ref_surveys.rds")
ref_labels <- readRDS("data/input/REFERENCE/ref_labels.rds")
ref_labels_abs <- readRDS("data/input/REFERENCE/ref_labels_abs.rds")
############## SETUP Graph Labels
ref_stim_id <- levels(ref_stimuli$ID)
ref_cat_questions <- c("MAKER_ID","MAKER_AGE","MAKER_GENDER")
ref_free_response <- c("MAKER_DETAIL", "MAKER_EXPLAIN", "TOOL_DETAIL", "CHART_EXPLAIN")
ref_conf_questions <- c("MAKER_CONF", "AGE_CONF", "GENDER_CONF", "TOOL_CONF")
ref_sd_questions <- rownames(ref_labels)
ref_sd_questions_abs <- rownames(ref_labels_abs)
# ref_blocks <- c("block1", "block2", "block3", "block4", "block5", "block6")
ref_blocks <- c(1,2,3,4,5,6)############## IMPORT DATA FILES
# df_data <- readRDS("data/output/df_data.rds") #1 row per participant — WIDE
df_participants <- readRDS("data/output/df_participants.rds") #1 row per participant — demographic
df_questions <- readRDS("data/output/df_questions.rds") #1 row per question — LONG
df_sd_questions_wide <- readRDS("data/output/df_sd_questions_wide.rds") # only sd questions WIDE
df_tools <- readRDS("data/output/df_tools.rds") #multiselect format for tools Question
df_actions <- readRDS("data/output/df_actions.rds") # multiselect format for action Question
# # df_graphs_full <- readRDS("data/output/df_graphs_full.rds") #includes free response data
df_graphs <- readRDS("data/output/df_graphs.rds") #only categorical and numeric questions
df_sd_questions_long <- readRDS("data/output/df_sd_questions_long.rds") # only sd questions LONG
### DATA FILES WITH (VARIABLE-WISE) Z-SCORED SEMANTIC DIFFERENTIAL QS
df_graphs_z <- readRDS("data/output/df_graphs_z.rds") #only categorical and numeric questions
df_sd_questions_long_z <- readRDS("data/output/df_sd_questions_long_z.rds") # only sd questions LONG
### DATA FILES WITH ABSOLUTE VALUE SEMANTIC DIFFERENTIAL QS
df_graphs_abs <- readRDS("data/output/df_graphs_abs.rds") #only categorical and numeric questions
df_sd_questions_long_abs <- readRDS("data/output/df_sd_questions_long_abs.rds") # only sd questions LONG1.2 Set up Graphing
############## SETUP Colour Palettes
#https://www.r-bloggers.com/2022/06/custom-colour-palettes-for-ggplot2/
## list of color pallettes
my_colors = list(
politics = c("#184aff","#5238bf", "#4f4a52" ,"#84649c", "#ff0000"),
blackred = c("black","red"),
greys = c("#707070","#999999","#C2C2C2"),
greens = c("#ADC69D","#81A06D","#567E39","#2D5D16","#193E0A"),
smallgreens = c("#ADC69D","#567E39","#193E0A"), ## MALE FEMALE OTHER
olives = c("#CDCEA1","#B8B979","#A0A054","#78783F","#50502A","#35351C"),
lightblues = c("#96C5D2","#61A2B2","#3C8093","#2C6378","#1F4A64"),
darkblues = c("#7AAFE1","#3787D2","#2A73B7","#225E96","#1A4974","#133453"),
reds = c("#D9B8BD","#CE98A2","#B17380","#954E5F","#78263E","#62151F"),
traffic = c("#CE98A2","#81A06D","yellow"),
questions = c("#B17380","#3787D2", "#567E39", "#EE897F"),
tools= c("#D55662","#EE897F","#F5D0AD","#A0B79B","#499678","#2D363A"), #? ... design.....vis...... programming
encounter = c("#8E8E8E","#729B7D"), ##SCROLL ENGAGE
actions2 = c("#8E8E8E","#729B7D"),
actions4 = c("#8E8E8E", "#A3A3A3","#729B7D","#499678"),
actions3 = c("#8E8E8E","#99b898ff","#fdcea8ff"),
actions = c("#8E8E8E","#2A363B","#99b898ff","#fdcea8ff","#ff837bff","#e84a60ff"),
platforms = c("#5D93EA","#FF70CD", "#3BD3F5", "#8B69B5","black"),
amy_gradient = c("#ac57aa", "#9e5fa4", "#90689f", "#827099", "#747894", "#66818e", "#578988", "#499183", "#3b997d", "#2da278", "#1faa72"),
my_favourite_colours = c("#702963", "#637029", "#296370")
)
## function for using palettes
my_palettes = function(name, n, all_palettes = my_colors, type = c("discrete","continuous"), direction = c("1","-1")) {
palette = all_palettes[[name]]
if (missing(n)) {
n = length(palette)
}
type = match.arg(type)
out = switch(type,
continuous = grDevices::colorRampPalette(palette)(n),
discrete = palette[1:n]
)
out = switch(direction,
"1" = out,
"-1" = palette[n:1])
structure(out, name = name, class = "palette")
}############## RETURNS SD STACKED AND COLORED BY BY X
## LOOP STYLE
multi_sd <- function (data, left, right, x, y, color) {
# g <- ggplot(df, aes(y = .data[[x]], x = {{y}}, color = {{color}}))+
g <- ggplot(data, aes(y = .data[[x]], x = .data[[y]], color = .data[[color]]))+
geom_boxplot(width = 0.5) +
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
guides(
y = guide_axis_manual(labels = left),
y.sec = guide_axis_manual(labels = right)
) + theme_minimal()
return(g)
}
############## RETURNS SINGLE SD
## LOOP STYLE
single_sd <- function (data, left, right, x) {
g <- ggplot(data, aes(y = {{x}}, x = ""))+
geom_boxplot(width = 0.5) +
geom_jitter(width = 0.1, alpha=0.5) +
scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
guides(
y = guide_axis_manual(labels = left),
y.sec = guide_axis_manual(labels = right)
) + theme_minimal()
return(g)
}
# ######## RETURNS SINGLE SD
# ## APPLY STYLE
plot_sd = function (data, column, type, mean, facet, facet_by, boxplot, labels) {
ggplot(data, aes(y = .data[[column]], x="")) +
{if(boxplot) geom_boxplot(width = 0.5) } +
geom_jitter(width = 0.1, alpha=0.2, {if(facet) aes(color=.data[[facet_by]])}) +
{if(mean)
stat_summary(fun="mean", geom="point", shape=20, size=5, color="blue", fill="blue")
} +
{if(mean)
## assumes data has been passed in with mean column at m
# stat_summary(fun="mean", geom="text", colour="blue", fontface = "bold",
# vjust=-1.25, hjust = 0.50, aes( label=round(..y.., digits=0)))
stat_summary(fun="mean", geom="text", colour="blue", fontface = "bold",
vjust=-1.25, hjust = 0.50, aes( label=round(..y.., digits=0)))
} +
{if(facet) facet_grid(.data[[facet_by]] ~ .)} +
# scale_y_continuous(limits=c(-1,101)) +
labs(x="", y="") +
coord_flip() +
{if(type == "S")
guides(
y = guide_axis_manual(labels = labels[column,"left"]),
y.sec = guide_axis_manual(labels = labels[column,"right"])
)} +
{if(type == "Q")
guides(
y = guide_axis_manual(labels = labels[q,"left"]),
y.sec = guide_axis_manual(labels = labels[q,"right"])
)} +
theme_minimal() +
labs (
caption = column
) + easy_remove_legend()
}2 STIMULUS B0-0 ANALYSIS
2.1 Sample Demographics
df <- df_participants
## FOR DESCRIPTIVES PARAGRAPH
# #PROLIFIC
df.p <- df %>% filter(Distribution == "PROLIFIC")
desc.gender.p <- table(df.p$D_gender) %>% prop.table()
names(desc.gender.p) <- levels(df.p$D_gender)
p_participants <- nrow(df.p)
# #TUMBLR
df.t <- df %>% filter(Distribution == "TUMBLR")
desc.gender.t <- table(df.t$D_gender) %>% prop.table()
names(desc.gender.t) <- levels(df.t$D_gender)
t_participants <- nrow(df.t)For study 2, a total of 318 participants were recruited from US-located English speaking users of TUMBLR (n = 78) and PROLIFIC (n = 240).
240 individuals from PROLIFIC participated in Study 2, ( 54% Female, 42% Male, 3% Non-binary, 1% Other).
78 individuals from Tumblr participated in Study 2, ( 36% Female, 5% Male, 40% Non-binary, 19% Other). Note that a higher proportion of participants recruited from TUMBLR report identities other than cis-gender Female and cis-gender Male.
2.2 Study Response Time
df <- df_participants
## for descriptives paragraph
p.desc.duration <- psych::describe(df %>% filter(Distribution=="PROLIFIC") %>% pull(duration.min))
t.desc.duration <- psych::describe(df %>% filter(Distribution=="TUMBLR") %>% pull(duration.min))PROLIFIC SAMPLE (n = 240 ) participant response times ranged from 13.97 to 216.18 minutes, with a mean response time of 42.49 minutes, SD = 21.15.
TUMBLR SAMPLE (n = 78 ) participant response times ranged from 10.88 to 227.57 minutes, with a mean response time of 51.93 minutes, SD = 35.47.
rm(df, df.p, df.t, p.desc.duration, t.desc.duration, desc.gender.p, desc.gender.t, p_participants, t_participants)#full stimulus-level data
df_b00 <- df_graphs %>% filter(STIMULUS == "B0-0") %>%
mutate(
STUDY = "" #dummy variable for univariate visualizations
) %>% droplevels()
# %>%
# mutate(MAKER_ID = fct_rev(MAKER_ID))2.3 CONFIDENCE
When asking participants to identify the type, age and gender of the maker of a visualization, we also asked participants to indicate their confidence in these choices.
Across all participants and all stimuli, are these (categorical) questions answered with the same degree of confidence? Here we examine both the central tendency (mean) and shape of the distribution for each confidence variable.
df <- df_b00 %>% select(PID, Distribution, STIMULUS,MAKER_CONF, AGE_CONF, GENDER_CONF, TOOL_CONF) %>%
pivot_longer(
cols = c(MAKER_CONF, AGE_CONF, GENDER_CONF, TOOL_CONF),
names_to = "QUESTION",
values_to = "CONFIDENCE"
) %>%
mutate(
QUESTION = factor(QUESTION, levels=c("MAKER_CONF","AGE_CONF","GENDER_CONF","TOOL_CONF" ) )
) %>% droplevels()
## B
## CONFIDENCE ACROSS QUESTIONS (all stimuli, all Pps)
## BOXPLOT W/ JITTER
B <- df %>% ggplot(aes(x=QUESTION, y= CONFIDENCE)) +
geom_boxplot(width = 0.5) +
geom_jitter(alpha = 0.25, position=position_dodge2(width = 0.25)) +
stat_summary(fun=mean, geom="text", colour="blue", fontface = "bold",
vjust=+0.5, hjust = -1.25, aes( label=round(..y.., digits=0)))+
stat_summary(fun=mean, geom="point", size = 4, colour="blue")+
theme_minimal() +
labs(title = "Confidence by Survey Question", caption = "(mean in blue)")
## R
## CONFIDENCE ACROSS QUESTIONS (all stimuli, all Pps)
## RIDGEPLOT W/ INTERVAL MEAN
R <- df %>%
ggplot(aes(x=CONFIDENCE, y=fct_rev(QUESTION), fill=fct_rev(QUESTION))) +
geom_density_ridges(scale = 0.65, alpha = 0.75, quantile_lines = TRUE) +
scale_x_continuous(limits = c(0,100))+
scale_fill_manual(values = my_palettes(name="questions", direction = "-1"), name = "", guide = guide_legend(reverse = TRUE)) +
stat_pointinterval(side = "bottom", scale = 0.7, slab_linewidth = NA, point_interval = "mean_qi") +
stat_summary(fun=mean, geom="text", colour="blue", fontface = "bold",
vjust=+2, hjust = 0.50, aes( label=round(..x.., digits=0)))+
stat_summary(fun="mean", geom="point", shape=20, size=5, color="blue", fill="blue") +
theme_minimal() +
labs(title = "Confidence by Survey Question", y = "QUESTION", caption =" (mean in blue)") +
easy_remove_legend()
# GGDIST HALFEYE (raincloud doesn't work b/c long tails)
ggplot(df, aes(y = fct_rev(QUESTION), x = CONFIDENCE, fill = QUESTION)) +
stat_halfeye(scale=1, density="bounded", point_interval = "mean_qi", alpha = 0.5) +
scale_fill_manual(values = my_palettes(name="questions", direction = "-1"), name = "", guide = guide_legend(reverse = TRUE)) +
# stat_interval(side = "bottom", scale = 2, slab_linewidth = NA) +
stat_summary(fun=mean, geom="text", colour="blue", fontface = "bold",
vjust=+2, hjust = 0.50, aes( label=round(..x.., digits=0)))+
stat_summary(fun="mean", geom="point", shape=20, size=5, color="blue", fill="blue") +
labs (title = "BLOCK 2 CONFIDENCE BY STIMULUS & QUESTION", y = "") +
theme_minimal() + easy_remove_legend()
B
R## Picking joint bandwidth of 5.82
The distribution of each confidence score for the “B0-0” stimulus are
remarkably consistent!
2.3.1 MAKER ID
Participants were asked:
Who do you think is most likely responsible for having this
image created?
options: [business or corporation / journalist or news
outlet / educational or academic institution / government or political
organization / other organization / an individual] (select
one)
The response is stored as MAKER_ID
Participants were also asked: Please rate your confidence in
this choice. The response is stored as MAKER_CONF
.
#FILTER DATASET
df <- df_b00
## D
## MAKER IDENTIFICATION AGGREGATED (all)
## GGSTATSPLOT
##############################
#hack for consistent ordering of ggstats bar plot
dx <- df %>% mutate( MAKER_ID = fct_rev(MAKER_ID) )
## get chisqr gof from ggpiestats
stat <- extract_subtitle( ggpiestats( data = dx, x = MAKER_ID))
cap <- expression(chi^2~indicates~null~hypothesis~of~even~distribution~between~levels~can~be~rejected)
## display on ggbarstats
S <- ggbarstats(dx, x = MAKER_ID, y = STUDY) +
scale_fill_manual(values = my_palettes(name="reds", direction = "1")) +
theme_minimal() + labs(
title = "B0-0 | Distribution of MAKER_ID is not equal across levels",
subtitle = stat,
caption = cap
)## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale. # labs( title = "", x = "", y="") +
# theme(aspect.ratio = 1)
##############################
## H
## HALF EYE SLAB GGDIST
##############################
H <- df %>%
group_by(MAKER_ID) %>%
mutate(count = n(), m = mean(MAKER_CONF)) %>%
ggplot(aes(y = MAKER_CONF, x = fct_rev(MAKER_ID), fill = fct_rev(MAKER_ID))) +
stat_halfeye(scale=0.55, density="bounded", point_interval = "mean_qi", normalize= "all") +
## MEAN
stat_summary(fun=mean, geom="text", colour="blue", fontface = "bold", size = 2,
vjust=2.5, hjust = .5, aes( label=round(m, digits=0)))+
stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
scale_fill_manual(values = my_palettes(name="reds", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
geom_text(aes(label= paste0("n=",count) , y = 5), color = "black",
size = 3, nudge_x=0.35) +
labs(y="Maker ID Confidence", x="", title = "B0-0 | MAKER CONFIDENCE by MAKER_ID", caption = "(blue indicates mean)") +
theme_minimal() +
easy_remove_legend()+
coord_flip()
##############################
## B
## JITTER BOXPLOT
##############################
B <- df %>%
group_by(MAKER_ID) %>%
mutate(count = n(), m = mean(MAKER_CONF)) %>%
ggplot(aes(y = MAKER_CONF, x = fct_rev(MAKER_ID), color = fct_rev(MAKER_ID))) +
geom_boxplot() +
geom_point(position = position_jitter(width=0.2)) +
scale_color_manual(values = my_palettes(name="reds", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
## MEAN
stat_summary(fun=mean, geom="text", colour="blue", fontface = "bold", size = 2,
vjust=2.5, hjust = .5, aes( label=round(m, digits=0)))+
stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
scale_fill_manual(values = my_palettes(name="lightblues", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
geom_text(aes(label= paste0("n=",count) , y = 5), color = "black",
size = 3, nudge_x=0.35) +
theme_minimal() + easy_remove_legend() +
labs(title = "B0-0 | MAKER CONFIDENCE by MAKER_ID", x = "MAKER_ID")
S 
H
B
2.3.2 MAKER AGE
Participants were asked:
Take a moment to imagine the person(s) responsible for creating
the image. What generation are they most likely
from?
options: [boomers (60+ years old) / Generation X (44-59
years old) / Millennials (28-43 years old) / Generation Z (12 - 27 years
old] (select one)
The response was saved as MAKER_AGE
Participants were asked: Please rate your confidence in this
choice. The response is stored as AGE_CONF .
#FILTER DATASET
df <- df_b00
## D
## MAKER IDENTIFICATION AGGREGATED (all)
## GGSTATSPLOT
##############################
#hack for consistent ordering of ggstats bar plot
dx <- df %>% mutate( MAKER_AGE = fct_rev(MAKER_AGE) )
## get chisqr gof from ggpiestats
stat <- extract_subtitle( ggpiestats( data = dx, x = MAKER_AGE))
cap <- expression(chi^2~indicates~null~hypothesis~of~even~distribution~between~levels~can~be~rejected)
## display on ggbarstats
S <- ggbarstats(dx, x = MAKER_AGE, y = STUDY) +
scale_fill_manual(values = my_palettes(name="lightblues", direction = "1")) +
theme_minimal() + labs(
title = "B0-0 | Distribution of MAKER_AGE is not equal across levels",
subtitle = stat,
caption = cap
)## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale. # labs( title = "", x = "", y="") +
# theme(aspect.ratio = 1)
##############################
## H
## HALF EYE SLAB GGDIST
##############################
H <- df %>%
group_by(MAKER_AGE) %>%
mutate(count = n(), m = mean(AGE_CONF)) %>%
ggplot(aes(y = AGE_CONF, x = fct_rev(MAKER_AGE), fill = fct_rev(MAKER_AGE))) +
stat_halfeye(scale=0.55, density="bounded", point_interval = "mean_qi", normalize= "all") +
## MEAN
stat_summary(fun=mean, geom="text", colour="blue", fontface = "bold", size = 2,
vjust=2.5, hjust = .5, aes( label=round(m, digits=0)))+
stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
scale_fill_manual(values = my_palettes(name="lightblues", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
geom_text(aes(label= paste0("n=",count) , y = 5), color = "black",
size = 3, nudge_x=0.35) +
labs(y="Maker ID Confidence", x="", title = "B0-0 | AGE CONFIDENCE by MAKER_AGE", caption = "(blue indicates mean)") +
theme_minimal() +
easy_remove_legend()+
coord_flip()
##############################
## B
## JITTER BOXPLOT
##############################
B <- df %>%
group_by(MAKER_AGE) %>%
mutate(count = n(), m = mean(AGE_CONF)) %>%
ggplot(aes(y = AGE_CONF, x = fct_rev(MAKER_AGE), color = fct_rev(MAKER_AGE))) +
geom_boxplot() +
geom_point(position = position_jitter(width=0.2)) +
scale_color_manual(values = my_palettes(name="lightblues", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
## MEAN
stat_summary(fun=mean, geom="text", colour="blue", fontface = "bold", size = 2,
vjust=2.5, hjust = .5, aes( label=round(m, digits=0)))+
stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
scale_fill_manual(values = my_palettes(name="lightblues", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
geom_text(aes(label= paste0("n=",count) , y = 5), color = "black",
size = 3, nudge_x=0.35) +
theme_minimal() + easy_remove_legend() +
labs(title = "B0-0 | AGE CONFIDENCE by MAKER_AGE", x = "MAKER_AGE")
S 
H
B
2.3.3 MAKER GENDER
Participants were asked:
Take a moment to imagine the person(s) responsible for creating
the image. What gender do they most likely identify
with?
options: [female / male / other ] (select
one)
Responses were stored as MAKER_GENDER.
Participants were asked: Please rate your confidence in this
choice. The response is stored as GENDER_CONF
.
#FILTER DATASET
df <- df_b00
## D
## MAKER IDENTIFICATION AGGREGATED (all)
## GGSTATSPLOT
##############################
#hack for consistent ordering of ggstats bar plot
# dx <- df %>% mutate( MAKER_GENDER = fct_rev(MAKER_GENDER) )
## get chisqr gof from ggpiestats
stat <- extract_subtitle( ggpiestats( data = df, x = MAKER_GENDER))
cap <- expression(chi^2~indicates~null~hypothesis~of~even~distribution~between~levels~can~be~rejected)
## display on ggbarstats
S <- ggbarstats(df, x = MAKER_GENDER, y = STUDY) +
scale_fill_manual(values = my_palettes(name="smallgreens", direction = "1"), guide = guide_legend(reverse = TRUE)) +
theme_minimal() + labs(
title = "B0-0 | Distribution of MAKER_GENDER is not equal across levels",
subtitle = stat,
caption = cap
)## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.##############################
## H
## HALF EYE SLAB GGDIST
##############################
H <- df %>%
group_by(MAKER_GENDER) %>%
mutate(count = n(), m = mean(GENDER_CONF)) %>%
ggplot(aes(y = GENDER_CONF, x = MAKER_GENDER, fill = MAKER_GENDER)) +
stat_halfeye(scale=0.55, density="bounded", point_interval = "mean_qi", normalize= "all") +
## MEAN
stat_summary(fun=mean, geom="text", colour="blue", fontface = "bold", size = 2,
vjust=2.5, hjust = .5, aes( label=round(m, digits=0)))+
stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
scale_fill_manual(values = my_palettes(name="smallgreens", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
geom_text(aes(label= paste0("n=",count) , y = 5), color = "black",
size = 3, nudge_x=0.35) +
labs(y="Maker ID Confidence", x="", title = "B0-0 | MAKER CONFIDENCE by MAKER_GENDER", caption = "(blue indicates mean)") +
theme_minimal() +
easy_remove_legend()+
coord_flip()
##############################
## B
## JITTER BOXPLOT
##############################
B <- df %>%
group_by(MAKER_GENDER) %>%
mutate(count = n(), m = mean(GENDER_CONF)) %>%
ggplot(aes(y = GENDER_CONF, x = MAKER_GENDER, color = MAKER_GENDER)) +
geom_boxplot() +
geom_point(position = position_jitter(width=0.2)) +
scale_color_manual(values = my_palettes(name="smallgreens", direction = "1"), guide = guide_legend(reverse = TRUE)) +
## MEAN
stat_summary(fun=mean, geom="text", colour="blue", fontface = "bold", size = 2,
vjust=2.5, hjust = .5, aes( label=round(m, digits=0)))+
stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
scale_fill_manual(values = my_palettes(name="smallgreens", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
geom_text(aes(label= paste0("n=",count) , y = 5), color = "black",
size = 3, nudge_x=0.35) +
theme_minimal() + easy_remove_legend() +
labs(title = "B0-0 | MAKER CONFIDENCE by MAKER_GENDER", x = "MAKER_GENDER")
S 
H
B
The distribution of maker genders is not evenly distributed between men
and women as we might expect. We think it is most likely that the ‘male’
category serves as a default value for the maker gender, in the absence
of any particular feature of stimulus that viewers interpret as strongly
feminine. This hypothesis is grounded in the free response data, however
it is only a hypothesis.
### TOOL ID
Participants were asked: What tools do you think were most
likely used to create this image?
options: [basic graphic design software (e.g. Canva, or
similar) / advanced graphic design software (e.g. Adobe Illustrator,
Figma, or similar) / data visualization software (e.g. Tableau, PowerBI,
or similar)/ general purpose software (e.g. MS Word/Excel, Google
Sheets, or similar) / programming language (e.g. R, python, javascript,
or similar) ] (select all that apply)
The response was saved as variable TOOL_ID
(multi-select)
Participants were asked: Please rate your confidence in this
choice. The response is stored as TOOL_CONF .
#FILTER DATASET
df <- df_tools %>%
filter(STIMULUS == "B0-0") %>%
mutate(
STUDY = ""
)
## D
## MAKER IDENTIFICATION AGGREGATED (all)
## GGSTATSPLOT
##############################
stat <- extract_subtitle( ggpiestats( data = df, x = TOOL_ID))
cap <- expression(chi^2~indicates~null~hypothesis~of~even~distribution~between~levels~can~be~rejected)
## display on ggbarstats
S <- ggbarstats( data = df, x = TOOL_ID, y = STUDY,
legend.title = "TOOL ID") +
scale_fill_manual(values = my_palettes(name="tools", direction = "1"), guide = guide_legend(reverse = TRUE)) +
theme_minimal() + labs(
title = "B0-0 | Distribution of TOOL_ID is not equal across levels",
subtitle = stat,
caption = cap
)## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.##############################
## H
## HALF EYE SLAB GGDIST
##############################
H <- df %>%
group_by(TOOL_ID) %>%
mutate(count = n(), m = mean(TOOL_CONF)) %>%
ggplot(aes(y = TOOL_CONF, x = TOOL_ID, fill = TOOL_ID)) +
stat_halfeye(scale=0.55, density="bounded", point_interval = "mean_qi", normalize= "all") +
## MEAN
stat_summary(fun=mean, geom="text", colour="blue", fontface = "bold", size = 2,
vjust=2.5, hjust = .5, aes( label=round(..y.., digits=0)))+
stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
scale_fill_manual(values = my_palettes(name="tools", direction = "1"), guide = guide_legend(reverse = TRUE)) +
geom_text(aes(label= paste0("n=",count) , y = 5), color = "black",
size = 3, nudge_x=0.35) +
labs(y="TOOL ID Confidence", x="", caption="(mean in blue) (median in red)",
title = "B0-0 | Distribution of TOOL CONFIDENCE by TOOL_ID ") +
theme_minimal() +
easy_remove_legend()+
coord_flip()
##############################
## B
## JITTER BOXPLOT
##############################
B <- df %>%
group_by(TOOL_ID) %>%
mutate(count = n(), m = mean(TOOL_CONF)) %>%
ggplot(aes(y = TOOL_CONF, x =TOOL_ID, color = TOOL_ID)) +
geom_boxplot() +
geom_point(position = position_jitter(width=0.2)) +
scale_color_manual(values = my_palettes(name="tools", direction = "1"), guide = guide_legend(reverse = TRUE)) +
## MEAN
stat_summary(fun=mean, geom="text", colour="blue", fontface = "bold", size = 2,
vjust=2.5, hjust = .5, aes( label=round(m, digits=0)))+
stat_summary(fun=mean, geom="point", shape=20, size=3, color="blue", fill="blue") +
scale_fill_manual(values = my_palettes(name="smallgreens", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
geom_text(aes(label= paste0("n=",count) , y = 5), color = "black",
size = 3, nudge_x=0.35) +
theme_minimal() + easy_remove_legend() +
labs(title = "B0-0 | TOOL CONFIDENCE by TOOL_ID", x = "TOOL_ID")2.3.4 ENCOUNTER CHOICE
The first question each participant saw in each stimulus block was:
As you’re scrolling through your feed, you see this image. What
would you do? options: keep scrolling, pause and look at the
image The response was saved as variable ENCOUNTER (select
one)
df <- df_b00
## B
## ENCOUNTER BY STIMULUS
## GGSTATSPLOT
## get chisqr gof from ggpiestats
stat <- extract_subtitle( ggpiestats( data = df, x = ENCOUNTER))
cap <- expression(chi^2~indicates~null~hypothesis~of~even~distribution~between~levels~can~be~rejected)
df_b00 %>%
ggbarstats(
x = ENCOUNTER, y = STUDY,
legend.title = "ENCOUNTER",
results.subtitle = FALSE) +
scale_fill_manual(values = my_palettes(name="encounter", direction = "-1"))+
theme_minimal() +
labs( title = "B0-0 | ENCOUNTER Choice ", x = "",
subtitle = stat, caption = cap)## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
Participants chose to ‘engage’ rather than ‘scroll past’ 69% of the
time.
2.3.5 ACTION CHOICE
The last question participants were asked in each stimulus block was:
Imagine you encounter the following image while scrolling. Which
of the following are you most likely to do? options: post a
comment, share/repost, share/repost WITH comment, look up more
information about the topic or source, unfollow/block the source,
NOTHING—just keep scrolling The response was saved as variable
CHART_ACTION (multi-select)
## B
## ACTION BY STIMULUS
## GGSTATSPLOT
#hack for consistent ordering of ggstats bar plot
df <- df_actions %>%
filter(STIMULUS=="B0-0") %>%
mutate(
CHART_ACTION = fct_rev(CHART_ACTION),
STUDY="")
## get chisqr gof from ggpiestats
stat <- extract_subtitle( ggpiestats( data = df, x = CHART_ACTION))
cap <- expression(chi^2~indicates~null~hypothesis~of~even~distribution~between~levels~can~be~rejected)
df %>%
ggbarstats( x = CHART_ACTION, y = STUDY,
legend.title = "CHART ACTION",
results.subtitle = FALSE) +
# scale_fill_paletteer_d("awtools::a_palette", direction = 1)+
scale_fill_manual(values = my_palettes(name="actions", direction = "1"))+
theme_minimal() +
labs( title = "B0-0 | ACTION Choice ", subtitle = stat, x = "", caption = cap)## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
A high proportion of participants answered ‘nothing’ chart action, which
is not surprising given the social media context. I am surprised to see
such a high proportion answering that they would seek further
information!
2.4 SEMANTIC DIFFERENTIALS
Participants were also asked to rate certain characteristics of the chart, or its maker, along a semantic differential scale, implemented in Qualtrics as a continuous slider ranging from 0 -> 100 with biploar adjectives at the end of each scale. The slider defaulted to the center point (50), and the interface displayed the numeric value of the slider position as a tooltip while the element had focus. Note that on both touch and mouse devices participants could interact with the survey element as a slider (i.e. click and and drag, or touch and drag) or as a visual analogue scale (i.e. click or tap on position along the scale).
2.4.1 AGGREGATED
2.4.1.1 FULL SCALES
The SD scores visualized here are in the same form as the participants’ response scale (slider from 0-100).
2.4.1.2 AGGREGATED
2.4.1.2.1 boxplot
#### LIST OF BLOXPLOTS + JITTER #############################################################################
# setup dataframe
df <- df_b00
#subset data cols
cols <- df %>% select( all_of(ref_sd_questions))
plots <- as.list(lapply(colnames(cols), plot_sd, data = df, type ="S", mean=TRUE, facet = FALSE, boxplot=TRUE, labels=ref_labels))
#aggregate q plots into one for stimulus
plot_master_questions <- plots[[1]] / plots[[2]] / plots[[3]] / plots[[4]] / plots[[5]] / plots[[6]] / plots[[7]] /
plots[[8]] /plots[[9]] /plots[[10]] /plots[[11]] +
plot_annotation(
title = "B0-0 | MILLENIAL PINK PLANTS",
subtitle ="", caption = "(point is mean)"
)
if(GRAPH_SAVE == TRUE){
ggsave(plot = plot_master_questions, path="figs/level_b00/distributions", filename =paste0("b00","_box.png"), units = c("in"), width = 10, height = 14 )
}
print(plot_master_questions)
2.4.1.2.2 ggdist halfeye
#### GGDIST PLOT#############################################################################
# setup dataframe
df <- df_sd_questions_long %>% filter(STIMULUS == "B0-0") %>% select(1:8, QUESTION, STIMULUS_CATEGORY, value)
d <- left_join( x = df, y = ref_labels,
by = c("QUESTION" = "ref_sd_questions")) %>%
mutate(
category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
QUESTION = factor(QUESTION, levels=ref_sd_questions)) %>%
group_by(QUESTION) %>%
mutate(m=median(value)) ## calc median for printing on graph
# GGDIST HALFEYE (raincloud doesn't work b/c long tails)
(g <- d %>%
ggplot(aes(y = fct_rev(QUESTION), x = value, fill=category)) +
stat_halfeye(scale=0.8, density="bounded", point_interval = "median_qi", normalize="xy") +
## MEDIAN
stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
vjust=+2, hjust = 0.50, aes(label=round(m, digits=0)))+
stat_summary(fun=median, geom="point", size=2) +
scale_color_manual(values = my_palettes(name="greys", direction = "1"))+
scale_fill_manual(values = my_palettes(name="greys", direction = "1"))+
guides(
y = guide_axis_manual(labels = rev(ref_labels$left), title = ""),
y.sec = guide_axis_manual(labels = rev(ref_labels$right))
) +
cowplot::draw_text(text = ref_sd_questions, x = 90, y= ref_sd_questions,size = 8, vjust=-2) +
labs (title = "B0-0 | MILLENIAL PINK PLANTS", y = "", caption = "(point is median)") +
theme_minimal() + easy_remove_legend()
)
if(GRAPH_SAVE == TRUE){
ggsave(plot = g, path="figs/level_b00/distributions", filename =paste0("b00","_ggdist.png"), units = c("in"), width = 10, height = 14 )
}2.4.1.2.3 density ridges
#### DENSITY RIDGES#############################################################################
# setup dataframe
df <- df_sd_questions_long %>% filter(STIMULUS=="B0-0") %>% select(1:8, QUESTION, value)
d <- left_join( x = df, y = ref_labels,
by = c("QUESTION" = "ref_sd_questions")) %>%
mutate(
category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
QUESTION = factor(QUESTION, levels=ref_sd_questions))%>%
group_by(QUESTION) %>%
mutate(m=median(value)) ## calc median for printing on graph
(x <-
ggplot(d, aes(x = value, y = fct_rev(QUESTION), fill = category)) +
geom_density_ridges(scale = 0.75, quantile_lines = TRUE, alpha = 0.75, panel_scaling = TRUE) +
# scale_fill_manual(values = my_palettes(name="amy_gradient", direction = "1"))+
scale_fill_manual(values = my_palettes(name="greys", direction = "1"))+
## MEDIAN
stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
vjust=+2, hjust = 0.50, aes(label=round(m, digits=0)))+
stat_summary(fun=median, geom="point", size=2) +
# scale_x_continuous(limits = c(0,100))+
guides(
y = guide_axis_manual(labels = rev(ref_labels$left)),
y.sec = guide_axis_manual(labels = rev(ref_labels$right))
) +
labs (title = "B0-0 | MILLENIAL PINK PLANTS", y = "", caption = "(point is median)") +
cowplot::draw_text(text = ref_sd_questions, x = 100, y= ref_sd_questions,size = 8, vjust=-2, position=position_nudge(y=-.20)) + ##raw
# cowplot::draw_text(text = ref_sd_questions, x = -4, y= ref_sd_questions,size = 10, vjust=-2) + ##z-score
theme_minimal() + easy_remove_legend()
)## Picking joint bandwidth of 6.14
if(GRAPH_SAVE == TRUE) {
ggsave(plot = x, path="figs/level_b00/distributions", filename =paste0("b00","_ridges.png"), units = c("in"), width = 10, height = 14 )
}## Picking joint bandwidth of 6.142.4.1.3 ABSOLUTE VALUES
Here the scale of the semantic differential questions have been collapsed, such that 0 is the midpoint of the scale (indicating uncertainty, or not strongly indicating either of the labelled traits) and both 100 and 0 are 50 (indicating a strong signal toward either of the labelled traits).
2.4.1.4 AGGREGATED
2.4.1.4.1 boxplot
#### LIST OF BLOXPLOTS + JITTER #############################################################################
# setup dataframe
df <- df_graphs_abs %>% filter(STIMULUS == "B0-0")
#subset data cols
cols <- df %>% select( all_of(ref_sd_questions_abs))
plots <- as.list(lapply(colnames(cols), plot_sd, data = df, type ="S", mean=TRUE, facet = FALSE, boxplot=TRUE, labels = ref_labels_abs))
#aggregate q plots into one for stimulus
plot_master_questions <- plots[[1]] / plots[[2]] / plots[[3]] / plots[[4]] / plots[[5]] / plots[[6]] / plots[[7]] /
plots[[8]] /plots[[9]] /plots[[10]] /plots[[11]] +
plot_annotation(
title = "B0-0 | MILLENIAL PINK PLANTS — SD (ABSOLUTE VALUE)",
subtitle ="", caption = "(point is mean)"
)
if(GRAPH_SAVE == TRUE){
ggsave(plot = plot_master_questions, path="figs/level_b00/distributions", filename =paste0("ABS_b00","_box.png"), units = c("in"), width = 10, height = 14 )
}
print(plot_master_questions)
2.4.1.4.2 ggdist halfeye
#### GGDIST PLOT#############################################################################
# setup dataframe
df <- df_sd_questions_long_abs %>% filter(STIMULUS == "B0-0") %>% select(1:8, QUESTION, STIMULUS_CATEGORY, value)
d <- left_join( x = df, y = ref_labels_abs,
by = c("QUESTION" = "ref_sd_questions_abs")) %>%
mutate(
category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
QUESTION = factor(QUESTION, levels=ref_sd_questions))%>%
group_by(QUESTION) %>%
mutate(m=median(value)) ## calc median for printing on graph
# GGDIST HALFEYE (raincloud doesn't work b/c long tails)
( g <- ggplot(d, aes(y = fct_rev(QUESTION), x = value, fill=category)) +
stat_halfeye(scale=0.8, density="bounded", point_interval = "median_qi", normalize="xy") +
scale_fill_manual(values = my_palettes(name="greys", direction = "1"))+
## MEDIAN
stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
vjust=+2, hjust = 0.50, aes(label=round(m, digits=0)))+
stat_summary(fun=median, geom="point", size=2) +
guides(
y = guide_axis_manual(labels = rev(ref_labels_abs$left), title = ""),
y.sec = guide_axis_manual(labels = rev(ref_labels_abs$right))
) +
cowplot::draw_text(text = ref_sd_questions, x = 45, y= ref_sd_questions_abs,size = 8, vjust=-2) +
labs (title = "B0-0 | MILLENIAL PINK PLANTS — SD (ABSOLUTE VALUE)", y = "", caption = "(point is median)") +
theme_minimal() + easy_remove_legend()
) 
if(GRAPH_SAVE == TRUE){
ggsave(plot = g, path="figs/level_b00/distributions", filename =paste0("ABS_b00","_ggdist.png"), units = c("in"), width = 10, height = 14 )
}2.4.1.4.3 density ridges
#### DENSITY RIDGES#############################################################################
# setup dataframe
df <- df_sd_questions_long_abs %>% filter(STIMULUS=="B0-0") %>% select(1:8, QUESTION, value)
d <- left_join( x = df, y = ref_labels_abs,
by = c("QUESTION" = "ref_sd_questions_abs")) %>%
mutate(
category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
QUESTION = factor(QUESTION, levels=ref_sd_questions))%>%
group_by(QUESTION) %>%
mutate(m=median(value)) ## calc median for printing on graph
( x <-ggplot(d, aes(x = value, y = fct_rev(QUESTION), fill = category)) +
geom_density_ridges(scale = 0.9,quantile_lines = TRUE, alpha = 0.75) +
# scale_fill_manual(values = my_palettes(name="amy_gradient", direction = "1"))+
scale_fill_manual(values = my_palettes(name="greys", direction = "1"))+
stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
vjust=+2, hjust = 0.50, aes(label=round(m, digits=0)))+
stat_summary(fun=median, geom="point", size=2) +
guides(
y = guide_axis_manual(labels = rev(ref_labels_abs$left)),
y.sec = guide_axis_manual(labels = rev(ref_labels_abs$right))
) +
labs(title = "B0-0 | MILLENIAL PINK PLANTS — SD (ABSOLUTE VALUE)", y = "", caption = "(point is median)") +
cowplot::draw_text(text = ref_sd_questions, x = 45, y= ref_sd_questions_abs, size = 8, vjust=-2, position=position_nudge(y=-.20)) + ##raw
theme_minimal() + easy_remove_legend()
)## Picking joint bandwidth of 3.84
if(GRAPH_SAVE == TRUE){
ggsave(plot = x, path="figs/level_b00/distributions", filename =paste0("ABS_b00","_ridges.png"), units = c("in"), width = 10, height = 14 )
}## Picking joint bandwidth of 3.84rm(df, dx, d, c,x,g,plot_master_questions, H, R,B,S)2.4.2 by ASSIGNMENT BLOCK
2.4.2.1 FULL SCALE
2.4.2.1.1 boxplots
#DEFINE STIMULI
# df <- df_graphs
df <- df_b00
stimuli <- levels(df$STIMULUS)
assignment <- levels(df$Assigned.Block)
## LOOP THROUGH EACH STIMULUS IN LIST
i = 0
for (s in assignment){
i = i+1
# setup dataframe
title <- ref_stimuli %>% filter(ID == stimuli) %>% select(NAME) ##TODO IF NOT WORK ref_stim_id
title <- paste0(stimuli, " (for block",s," subjects) | ",title)
df <- df_graphs %>% filter(STIMULUS== stimuli) |> filter(Assigned.Block == s)
#### BOXPLOT PLOT
#subset data cols
cols <- df %>% select( all_of(ref_sd_questions))
plots <- as.list(lapply(colnames(cols), plot_sd, data = df, type ="S", mean=TRUE, facet = FALSE, boxplot=TRUE, labels = ref_labels))
#aggregate q plots into one for stimulus
x <- plots[[1]] / plots[[2]] / plots[[3]] / plots[[4]] / plots[[5]] / plots[[6]] / plots[[7]] /
plots[[8]] /plots[[9]] /plots[[10]] /plots[[11]] +
plot_annotation(
title = title,
subtitle ="", caption = "(point is mean)")
if(GRAPH_SAVE){
ggsave(plot = x, path="figs/level_b00/distributions/by_assignment_group/boxplots", filename =paste0("B",s,"_sample_box.png"), units = c("in"), width = 10, height = 14 , bg='#ffffff' )}
} ## END LOOP 2.4.2.1.2 ggdist halfeye
#DEFINE STIMULI
# df <- df_graphs
df <- df_b00
stimuli <- levels(df$STIMULUS)
assignment <- levels(df$Assigned.Block)
## LOOP THROUGH EACH STIMULUS IN LIST
i = 0
for (s in assignment){
i = i+1
# setup dataframe
title <- ref_stimuli %>% filter(ID == stimuli) %>% select(NAME) ##TODO IF NOT WORK ref_stim_id
title <- paste0(stimuli, " (for block",s," subjects) | ",title)
# setup dataframe
df <- df_sd_questions_long %>% select(1:8, STIMULUS, QUESTION, STIMULUS_CATEGORY, value) %>% filter(STIMULUS == stimuli) |> filter(Assigned.Block == s)
d <- left_join( x = df, y = ref_labels,
by = c("QUESTION" = "ref_sd_questions")) %>%
mutate(
category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
QUESTION = factor(QUESTION, levels=ref_sd_questions)) %>%
group_by(QUESTION) %>%
mutate(m=median(value)) ## calc median for printing on graph
# GGDIST HALFEYE (raincloud doesn't work b/c long tails)
(g <- d %>%
ggplot(aes(y = fct_rev(QUESTION), x = value, fill=category)) +
stat_halfeye(scale=0.8, density="bounded", point_interval = "median_qi", normalize="xy") +
## MEDIAN
stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
vjust=+2, hjust = 0.50, aes(label=round(m, digits=0)))+
stat_summary(fun=median, geom="point", size=2) +
scale_color_manual(values = my_palettes(name="greys", direction = "1"))+
scale_fill_manual(values = my_palettes(name="greys", direction = "1"))+
guides(
y = guide_axis_manual(labels = rev(ref_labels$left), title = ""),
y.sec = guide_axis_manual(labels = rev(ref_labels$right))
) +
cowplot::draw_text(text = ref_sd_questions, x = 90, y= ref_sd_questions,size = 8, vjust=-2) +
labs (title = title, y = "", caption = "(point is median)") +
theme_minimal() + easy_remove_legend()
)
if(GRAPH_SAVE){
ggsave(plot = g, path="figs/level_b00/distributions/by_assignment_group/ggdist", filename =paste0("B",s,"_sample_ggdist.png"), units = c("in"), width = 10, height = 14 , bg='#ffffff' )}
} ## END LOOP 2.4.2.1.3 density ridges
#DEFINE STIMULI
# df <- df_graphs
df <- df_b00
stimuli <- levels(df$STIMULUS)
assignment <- levels(df$Assigned.Block)
## LOOP THROUGH EACH STIMULUS IN LIST
i = 0
for (s in assignment){
i = i+1
# setup titles
title <- ref_stimuli %>% filter(ID == stimuli) %>% select(NAME) ##TODO IF NOT WORK ref_stim_id
title <- paste0(stimuli, " (for block",s," subjects) | ",title)
#### DENSITY RIDGES#############################################################################
# setup dataframe
df <- df_sd_questions_long %>% select(1:8, QUESTION, STIMULUS, value) %>% filter(STIMULUS==stimuli) |> filter(Assigned.Block == s)
d <- left_join( x = df, y = ref_labels,
by = c("QUESTION" = "ref_sd_questions")) %>%
mutate(
category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
QUESTION = factor(QUESTION, levels=ref_sd_questions))%>%
group_by(QUESTION) %>%
mutate(m=median(value)) ## calc median for printing on graph
(x <-
ggplot(d, aes(x = value, y = fct_rev(QUESTION), fill = category)) +
geom_density_ridges(scale = 0.75, quantile_lines = TRUE, alpha = 0.75, panel_scaling = TRUE) +
# scale_fill_manual(values = my_palettes(name="amy_gradient", direction = "1"))+
scale_fill_manual(values = my_palettes(name="greys", direction = "1"))+
## MEDIAN
stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
vjust=+2, hjust = 0.50, aes(label=round(m, digits=0)))+
stat_summary(fun=median, geom="point", size=2) +
# scale_x_continuous(limits = c(0,100))+
guides(
y = guide_axis_manual(labels = rev(ref_labels$left)),
y.sec = guide_axis_manual(labels = rev(ref_labels$right))
) +
labs (title = title, y = "", caption = "(point is median)") +
cowplot::draw_text(text = ref_sd_questions, x = 100, y= ref_sd_questions,size = 8, vjust=-2, position=position_nudge(y=-.20)) + ##raw
# cowplot::draw_text(text = ref_sd_questions, x = -4, y= ref_sd_questions,size = 10, vjust=-2) + ##z-score
theme_minimal() + easy_remove_legend()
)
if(GRAPH_SAVE){
ggsave(plot = x, path="figs/level_b00/distributions/by_assignment_group/ridges", filename =paste0("B",s,"_sample_ridges.png"), units = c("in"), width = 10, height = 14 , bg='#ffffff' )}
} ## END LOOP STIMULUI## Picking joint bandwidth of 8.19## Picking joint bandwidth of 8.97## Picking joint bandwidth of 8.9## Picking joint bandwidth of 8.65## Picking joint bandwidth of 8.51## Picking joint bandwidth of 8.122.4.2.2 ABSOLUTE VALUE SCALE
2.4.2.2.1 boxplots
#DEFINE STIMULI
# df <- df_graphs
df <- df_b00
stimuli <- levels(df$STIMULUS)
assignment <- levels(df$Assigned.Block)
## LOOP THROUGH EACH STIMULUS IN LIST
i = 0
for (s in assignment){
i = i+1
# setup titles
title <- ref_stimuli %>% filter(ID == stimuli) %>% select(NAME) ##TODO IF NOT WORK ref_stim_id
title <- paste0(stimuli, " (for block",s," subjects) ABSOLUTE VALUE | ",title)
# setup data
df <- df_graphs_abs %>% filter(STIMULUS== stimuli) |> filter(Assigned.Block == s)
#### BOXPLOT PLOT
#subset data cols
cols <- df %>% select( all_of(ref_sd_questions))
plots <- as.list(lapply(colnames(cols), plot_sd, data = df, type ="S", mean=TRUE, facet = FALSE, boxplot=TRUE, labels = ref_labels_abs))
#aggregate q plots into one for stimulus
x <- plots[[1]] / plots[[2]] / plots[[3]] / plots[[4]] / plots[[5]] / plots[[6]] / plots[[7]] /
plots[[8]] /plots[[9]] /plots[[10]] /plots[[11]] +
plot_annotation(
title = title,
subtitle ="", caption = "(point is mean)")
if(GRAPH_SAVE){
ggsave(plot = x, path="figs/level_b00/distributions/by_assignment_group/boxplots", filename =paste0("ABS_B",s,"_sample_box.png"), units = c("in"), width = 10, height = 14 , bg='#ffffff' )}
} ## END LOOP 2.4.2.2.2 ggdist halfeye
#DEFINE STIMULI
# df <- df_graphs
df <- df_b00
stimuli <- levels(df$STIMULUS)
assignment <- levels(df$Assigned.Block)
## LOOP THROUGH EACH STIMULUS IN LIST
i = 0
for (s in assignment){
i = i+1
# setup dataframe
title <- ref_stimuli %>% filter(ID == stimuli) %>% select(NAME) ##TODO IF NOT WORK ref_stim_id
title <- paste0(stimuli, " (for block",s," subjects) ABSOLUTE VALUE | ",title)
# setup dataframe
df <- df_sd_questions_long_abs %>% select(1:8, STIMULUS, QUESTION, STIMULUS_CATEGORY, value) %>% filter(STIMULUS == stimuli) |> filter(Assigned.Block == s)
d <- left_join( x = df, y = ref_labels_abs,
by = c("QUESTION" = "ref_sd_questions_abs")) %>%
mutate(
category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
QUESTION = factor(QUESTION, levels=ref_sd_questions_abs)) %>%
group_by(QUESTION) %>%
mutate(m=median(value)) ## calc median for printing on graph
# GGDIST HALFEYE (raincloud doesn't work b/c long tails)
(g <- d %>%
ggplot(aes(y = fct_rev(QUESTION), x = value, fill=category)) +
stat_halfeye(scale=0.8, density="bounded", point_interval = "median_qi", normalize="xy") +
## MEDIAN
stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
vjust=+2, hjust = 0.50, aes(label=round(m, digits=0)))+
stat_summary(fun=median, geom="point", size=2) +
scale_color_manual(values = my_palettes(name="greys", direction = "1"))+
scale_fill_manual(values = my_palettes(name="greys", direction = "1"))+
guides(
y = guide_axis_manual(labels = rev(ref_labels_abs$left), title = ""),
y.sec = guide_axis_manual(labels = rev(ref_labels_abs$right))
) +
cowplot::draw_text(text = ref_sd_questions_abs, x = 45, y= ref_sd_questions_abs,size = 4, vjust=-6) +
labs (title = title, y = "", caption = "(point is median)") +
theme_minimal() + easy_remove_legend()
)
if(GRAPH_SAVE){
ggsave(plot = g, path="figs/level_b00/distributions/by_assignment_group/ggdist", filename =paste0("ABS_B",s,"_sample_ggdist.png"), units = c("in"), width = 10, height = 14 , bg='#ffffff' )}
} ## END LOOP 2.4.2.2.3 density ridges
#DEFINE STIMULI
# df <- df_graphs
df <- df_b00
stimuli <- levels(df$STIMULUS)
assignment <- levels(df$Assigned.Block)
## LOOP THROUGH EACH STIMULUS IN LIST
i = 0
for (s in assignment){
i = i+1
# setup titles
title <- ref_stimuli %>% filter(ID == stimuli) %>% select(NAME) ##TODO IF NOT WORK ref_stim_id
title <- paste0(stimuli, " (for block",s," subjects) ABSOLUTE VALUE | ",title)
#### DENSITY RIDGES#############################################################################
# setup dataframe
df <- df_sd_questions_long_abs %>% select(1:8, QUESTION, STIMULUS, value) %>% filter(STIMULUS==stimuli) |> filter(Assigned.Block==s)
d <- left_join( x = df, y = ref_labels_abs,
by = c("QUESTION" = "ref_sd_questions_abs")) %>%
mutate(
category=factor(category, levels=c("COMPETENCY","MAKER","CHART")),
QUESTION = factor(QUESTION, levels=ref_sd_questions_abs))%>%
group_by(QUESTION) %>%
mutate(m=median(value)) ## calc median for printing on graph
(x <-
ggplot(d, aes(x = value, y = fct_rev(QUESTION), fill = category)) +
geom_density_ridges(scale = 0.75, quantile_lines = TRUE, alpha = 0.75, panel_scaling = TRUE) +
# scale_fill_manual(values = my_palettes(name="amy_gradient", direction = "1"))+
scale_fill_manual(values = my_palettes(name="greys", direction = "1"))+
## MEDIAN
stat_summary(fun=median, geom="text", fontface = "bold", size= 2.2,
vjust=+2, hjust = 0.50, aes(label=round(m, digits=0)))+
stat_summary(fun=median, geom="point", size=2) +
# scale_x_continuous(limits = c(0,100))+
guides(
y = guide_axis_manual(labels = rev(ref_labels_abs$left)),
y.sec = guide_axis_manual(labels = rev(ref_labels_abs$right))
) +
labs (title = title, y = "", caption = "(point is median)") +
cowplot::draw_text(text = ref_sd_questions_abs, x = 50, y= ref_sd_questions,size = 4, vjust=-5, position=position_nudge(y=-.20)) + ##raw
# cowplot::draw_text(text = ref_sd_questions, x = -4, y= ref_sd_questions,size = 10, vjust=-2) + ##z-score
theme_minimal() + easy_remove_legend()
)
if(GRAPH_SAVE){
ggsave(plot = x, path="figs/level_b00/distributions/by_assignment_group/ridges", filename =paste0("ABS_B",s,"_sample_ridges.png"), units = c("in"), width = 10, height = 14 , bg='#ffffff' )}
} ## END LOOP STIMULUI## Picking joint bandwidth of 5.47## Picking joint bandwidth of 5.43## Picking joint bandwidth of 5.52## Picking joint bandwidth of 5.47## Picking joint bandwidth of 5.39## Picking joint bandwidth of 4.912.5 CORRELATIONS
2.5.1 FULL SCALE
df <- df_b00 %>% select(
MAKER_DESIGN, MAKER_DATA,
MAKER_POLITIC, MAKER_ARGUE,
MAKER_SELF, MAKER_ALIGN, MAKER_TRUST,
CHART_TRUST, CHART_INTENT, CHART_LIKE, CHART_BEAUTY,
PID)
# print("FULL CORRELATION NO RANDOM EFFECT")
# ## CALCULATE full correlations with no random effects
# c <- df %>% correlation(partial=FALSE, include_factors=FALSE)
# (s <- c %>% summary(redundant = FALSE))
# plot(s, show_data="point") + labs(title = "Correlation Matrix",
# subtitle="(full correlation; pearson method; Holm p-value adjustment)") + theme_minimal()
#
print("PARTIAL CORRELATION")## [1] "PARTIAL CORRELATION"#CALCULATE partial correlation
## no random effect needed b/c data only includes B0-0
## (this isolates correlation pairwise factoring out other variables)
c <- df %>% correlation(partial=TRUE)
(s <- c %>% summary(redundant = FALSE ))## # Correlation Matrix (pearson-method)
##
## Parameter | CHART_BEAUTY | CHART_LIKE | CHART_INTENT | CHART_TRUST | MAKER_TRUST | MAKER_ALIGN | MAKER_SELF | MAKER_ARGUE | MAKER_POLITIC | MAKER_DATA
## ----------------------------------------------------------------------------------------------------------------------------------------------------------
## MAKER_DESIGN | -0.24*** | 0.03 | -0.11 | 0.03 | -0.05 | 0.04 | -0.10 | 3.71e-03 | 0.10 | 0.36***
## MAKER_DATA | 0.06 | -0.10 | 0.14 | -0.03 | -0.09 | 0.02 | 0.06 | -0.03 | -4.66e-03 |
## MAKER_POLITIC | 0.11 | -5.86e-03 | -0.25*** | 8.35e-03 | 0.08 | -0.22** | 0.29*** | -0.12 | |
## MAKER_ARGUE | 0.13 | -0.04 | -0.14 | 0.02 | 0.12 | -0.05 | -0.12 | | |
## MAKER_SELF | -0.13 | 0.06 | 0.24*** | -0.13 | -0.10 | -0.32*** | | | |
## MAKER_ALIGN | 1.94e-03 | 0.08 | -0.04 | -0.05 | 0.30*** | | | | |
## MAKER_TRUST | -0.11 | 0.13 | -0.06 | 0.36*** | | | | | |
## CHART_TRUST | 0.07 | 0.25*** | -0.14 | | | | | | |
## CHART_INTENT | 0.12 | 3.53e-03 | | | | | | | |
## CHART_LIKE | 0.75*** | | | | | | | | |
##
## p-value adjustment method: Holm (1979)###### VIS WITH CORRELATION PACKAGE
#SEE [correlation] PLOT
g <- plot(s, show_data = "point", show_text = "label",
stars=TRUE, show_legend=FALSE,
show_statistic = FALSE, show_ci = FALSE) +
theme_minimal()+
labs(title = "B0-0 | Partial Correlation Matrix",
subtitle="(partial correlation; pearson method; Holm p-value adjustment")
# text = list(fontface = "italic")
g
ggsave(g, scale =1, filename = "figs/level_b00/heatmaps/B00_partial_correlation.png", width = 14, height = 6, dpi = 320, limitsize = FALSE)
#PLOT GAUSSIAN GRAPH MODEL
# plot(c)
###### VIS WITH CORRPLOT <- -- customizable but can't save to file ARGH
## GET THE MATRIX
m <- as.matrix(c)
## JUST CIRCLES
corrplot(m, method = 'circle', type = 'lower',
order = 'original', diag = FALSE, addCoef.col = "#7A7A7A",
tl.col = "black")
This plots depicts the PARTIAL CORRELATION pairwise between variables
(partial correlation factors out influence of other variables). The
resulting values are pearson moment-correlation coefficients ranging of
-1 (direct negative) to +1 direct positive correlation. These
correlations are calculated on the full scale semantic differential
questions (i.e. with the 0 - 100 range, where 1 and 100 are end points
and 50 is the central point)
2.5.1.1 node-link diagram
###################PLOT GAUSSIAN GRAPH MODEL
## get only significant correlations
m <- c # the correlation matrix
## default from easystats
# plot(m)
## 1 SIMPLY NODE NAMES
m <- as_tibble(c) %>%
mutate(
Parameter1 = str_replace_all(Parameter1, "MAKER_", "M_"),
Parameter1 = str_replace_all(Parameter1, "CHART_", "C_"),
Parameter2 = str_replace_all(Parameter2, "MAKER_", "M_"),
Parameter2 = str_replace_all(Parameter2, "CHART_", "C_")
)
## 2 SHOW ONLY SIGNIFICANT CORRELATIONS
m <- m %>%
filter(p <= 0.05)
## 3 FORMAT AS GRAPH
g <- as_tbl_graph(m)
### Gaussian Graphical Models (GGMs)
# Bhushan et al., 2019
# https://www.frontiersin.org/journals/psychology/articles/10.3389/fpsyg.2019.01050/full
# ggraph(g, layout = 'stress') +
f <-
ggraph(g, layout = 'stress') +
# ggraph(g, layout = 'linear', circular = TRUE) +
geom_edge_link(aes(colour =r,
edge_width = r,
label = round(r,2))) +
geom_node_point( size = 5) +
geom_node_label(size = 3,
# vjust = +1,
# hjust = 0.5,
repel = TRUE,
aes(label = name)) +
scale_edge_color_gradient2(low = "red",
mid = "white",
high = "blue",
midpoint = 0,
space = "Lab",
# na.value = "grey50",
guide = "edge_colourbar",
aesthetics = "edge_colour") +
theme_graph() + labs(title = "B0-0 | Significant Partial Correlations (full SD scale)")
f 
2.5.1.2 compare B1C node link diagram
df <- df_graphs %>%
filter(STIMULUS =="B1-3") %>%
select(
MAKER_DESIGN, MAKER_DATA,
MAKER_POLITIC, MAKER_ARGUE,
MAKER_SELF, MAKER_ALIGN, MAKER_TRUST,
CHART_TRUST, CHART_INTENT, CHART_LIKE, CHART_BEAUTY,
PID) %>% droplevels()
print("PARTIAL CORRELATION")## [1] "PARTIAL CORRELATION"#CALCULATE partial correlation
## no random effect needed b/c data only includes B0-0
## (this isolates correlation pairwise factoring out other variables)
c <- df %>% correlation(partial=TRUE)
(s <- c %>% summary(redundant = FALSE ))## # Correlation Matrix (pearson-method)
##
## Parameter | CHART_BEAUTY | CHART_LIKE | CHART_INTENT | CHART_TRUST | MAKER_TRUST | MAKER_ALIGN | MAKER_SELF | MAKER_ARGUE | MAKER_POLITIC | MAKER_DATA
## ----------------------------------------------------------------------------------------------------------------------------------------------------------
## MAKER_DESIGN | -0.13 | -7.66e-03 | -0.02 | 0.11 | -0.10 | 0.01 | 2.40e-03 | -0.04 | 0.03 | 0.82***
## MAKER_DATA | 0.02 | 0.07 | 0.18 | -0.14 | 0.04 | 0.05 | 0.07 | 0.11 | 0.06 |
## MAKER_POLITIC | 0.22 | -0.07 | -0.12 | 0.07 | -0.07 | -0.08 | 0.08 | -0.34 | |
## MAKER_ARGUE | 0.16 | -0.22 | -0.22 | 0.13 | 0.29 | -0.13 | -0.11 | | |
## MAKER_SELF | 0.11 | -0.22 | -0.25 | -6.48e-03 | 0.04 | -0.48** | | | |
## MAKER_ALIGN | -0.09 | -0.11 | -1.75e-03 | 0.15 | 0.44* | | | | |
## MAKER_TRUST | 0.05 | 0.09 | 0.07 | 0.41 | | | | | |
## CHART_TRUST | -0.07 | 0.49** | -0.41 | | | | | | |
## CHART_INTENT | 0.13 | 0.05 | | | | | | | |
## CHART_LIKE | 0.67*** | | | | | | | | |
##
## p-value adjustment method: Holm (1979)###### VIS WITH CORRELATION PACKAGE
#SEE [correlation] PLOT
g <- plot(s, show_data = "point", show_text = "label",
stars=TRUE, show_legend=FALSE,
show_statistic = FALSE, show_ci = FALSE) +
theme_minimal()+
labs(title = "B1-C | Partial Correlation Matrix",
subtitle="(partial correlation; pearson method; Holm p-value adjustment")
# text = list(fontface = "italic")
g
ggsave(g, scale =1, filename = "figs/level_b00/heatmaps/B1C_partial_correlation.png", width = 14, height = 6, dpi = 320, limitsize = FALSE)
#PLOT GAUSSIAN GRAPH MODEL
# plot(c)
###### VIS WITH CORRPLOT <- -- customizable but can't save to file ARGH
## GET THE MATRIX
m <- as.matrix(c)
## JUST CIRCLES
corrplot(m, method = 'circle', type = 'lower',
order = 'original', diag = FALSE, addCoef.col = "#7A7A7A",
tl.col = "black")
###################PLOT GAUSSIAN GRAPH MODEL
## get only significant correlations
m <- c # the correlation matrix
## default from easystats
# plot(m)
## 1 SIMPLY NODE NAMES
m <- as_tibble(c) %>%
mutate(
Parameter1 = str_replace_all(Parameter1, "MAKER_", "M_"),
Parameter1 = str_replace_all(Parameter1, "CHART_", "C_"),
Parameter2 = str_replace_all(Parameter2, "MAKER_", "M_"),
Parameter2 = str_replace_all(Parameter2, "CHART_", "C_")
)
## 2 SHOW ONLY SIGNIFICANT CORRELATIONS
m <- m %>%
filter(p <= 0.05)
## 3 FORMAT AS GRAPH
g <- as_tbl_graph(m)
### Gaussian Graphical Models (GGMs)
# Bhushan et al., 2019
# https://www.frontiersin.org/journals/psychology/articles/10.3389/fpsyg.2019.01050/full
# ggraph(g, layout = 'stress') +
f <-
ggraph(g, layout = 'stress') +
# ggraph(g, layout = 'linear', circular = TRUE) +
geom_edge_link(aes(colour =r,
edge_width = r,
label = round(r,2))) +
geom_node_point( size = 5) +
geom_node_label(size = 3,
# vjust = +1,
# hjust = 0.5,
repel = TRUE,
aes(label = name)) +
scale_edge_color_gradient2(low = "red",
mid = "white",
high = "blue",
midpoint = 0,
space = "Lab",
# na.value = "grey50",
guide = "edge_colourbar",
aesthetics = "edge_colour") +
theme_graph() + labs(title = "B1-C | Significant Partial Correlations (full scale)")
f 
2.5.2 ABSOLUTE VALUES
df <- df_graphs_abs %>%
filter(STIMULUS== "B0-0") %>%
select(
MAKER_DESIGN, MAKER_DATA,
MAKER_POLITIC, MAKER_ARGUE,
MAKER_SELF, MAKER_ALIGN, MAKER_TRUST,
CHART_TRUST, CHART_INTENT, CHART_LIKE, CHART_BEAUTY,
PID)
print("FULL CORRELATION NO RANDOM EFFECT")## [1] "FULL CORRELATION NO RANDOM EFFECT"## CALCULATE full correlations with no random effects
c <- df %>% correlation(partial=FALSE, include_factors=FALSE)
(s <- c %>% summary(redundant = FALSE))## # Correlation Matrix (pearson-method)
##
## Parameter | CHART_BEAUTY | CHART_LIKE | CHART_INTENT | CHART_TRUST | MAKER_TRUST | MAKER_ALIGN | MAKER_SELF | MAKER_ARGUE | MAKER_POLITIC | MAKER_DATA
## ----------------------------------------------------------------------------------------------------------------------------------------------------------
## MAKER_DESIGN | 0.26*** | 0.33*** | 0.11 | 0.14 | 0.04 | 0.09 | 0.17 | 0.12 | 0.07 | 0.34***
## MAKER_DATA | 0.15 | 0.22** | 0.12 | 0.18* | 0.05 | 0.03 | 0.11 | 0.11 | 0.12 |
## MAKER_POLITIC | 0.09 | 0.06 | 0.09 | 0.13 | 0.20** | 0.47*** | 0.46*** | 0.32*** | |
## MAKER_ARGUE | 0.11 | 0.10 | 0.25*** | 0.11 | 0.34*** | 0.50*** | 0.49*** | | |
## MAKER_SELF | 0.15 | 0.18* | 0.26*** | 0.17 | 0.50*** | 0.58*** | | | |
## MAKER_ALIGN | 0.14 | 0.15 | 0.23*** | 0.24*** | 0.48*** | | | | |
## MAKER_TRUST | 0.15 | 0.19* | 0.26*** | 0.42*** | | | | | |
## CHART_TRUST | 0.39*** | 0.49*** | 0.16 | | | | | | |
## CHART_INTENT | 0.18* | 0.19* | | | | | | | |
## CHART_LIKE | 0.64*** | | | | | | | | |
##
## p-value adjustment method: Holm (1979)plot(s, show_data="point") + labs(title = "Correlation Matrix — SD Questions — absolute values",
subtitle="(full correlation; pearson method; Holm p-value adjustment)") + theme_minimal()
print("PARTIAL CORRELATION")## [1] "PARTIAL CORRELATION"#CALCULATE partial correlations
# no PID as random effect bc data are just B0-0
## (this isolates correlation pairwise factoring out other variables)
c <- df %>% correlation(partial=TRUE)
(s <- c %>% summary(redundant = FALSE ))## # Correlation Matrix (pearson-method)
##
## Parameter | CHART_BEAUTY | CHART_LIKE | CHART_INTENT | CHART_TRUST | MAKER_TRUST | MAKER_ALIGN | MAKER_SELF | MAKER_ARGUE | MAKER_POLITIC | MAKER_DATA
## ----------------------------------------------------------------------------------------------------------------------------------------------------------
## MAKER_DESIGN | 0.06 | 0.19* | 0.01 | -0.03 | -0.08 | 8.61e-03 | 0.10 | 0.03 | -0.03 | 0.28***
## MAKER_DATA | -0.02 | 0.06 | 0.07 | 0.11 | -0.03 | -0.10 | 0.02 | 0.06 | 0.10 |
## MAKER_POLITIC | 0.04 | -0.07 | -0.06 | 0.07 | -0.13 | 0.29*** | 0.27*** | 0.04 | |
## MAKER_ARGUE | 0.03 | -0.03 | 0.11 | -0.05 | 0.06 | 0.26*** | 0.21** | | |
## MAKER_SELF | -2.71e-03 | 0.08 | 0.08 | -0.14 | 0.31*** | 0.24*** | | | |
## MAKER_ALIGN | -9.32e-04 | 4.12e-03 | 0.05 | 0.07 | 0.21** | | | | |
## MAKER_TRUST | -0.02 | -0.04 | 0.11 | 0.36*** | | | | | |
## CHART_TRUST | 0.11 | 0.31*** | -4.30e-03 | | | | | | |
## CHART_INTENT | 0.06 | 0.05 | | | | | | | |
## CHART_LIKE | 0.53*** | | | | | | | | |
##
## p-value adjustment method: Holm (1979)###### VIS WITH CORRELATION PACKAGE
#SEE [correlation] PLOT
g <- plot(s, show_data = "point", show_text = "label",
stars=TRUE, show_legend=FALSE,
show_statistic = FALSE, show_ci = FALSE) +
theme_minimal()+
labs(title = "B0-0 | Partial Correlation Matrix — SD Questions — absolute values",
subtitle="(partial correlation; pearson method; Holm p-value adjustment)")
# text = list(fontface = "italic")
g
ggsave(g, scale =1, filename = "figs/level_b00/heatmaps/B00_partial_correlation_abs.png", width = 14, height = 6, dpi = 320, limitsize = FALSE)
###### VIS WITH CORRPLOT <- -- customizable but can't save to file ARGH
## GET THE MATRIX
m <- as.matrix(c)
## JUST CIRCLES
corrplot(m, method = 'circle', type = 'lower',
order = 'original', diag = FALSE, addCoef.col = "#7A7A7A",
tl.col = "black")
These plots depict the PARTIAL CORRELATION pairwise between variables (partial correlation factors out influence of other variables). The resulting values are pearson moment-correlation coefficients ranging of -1 (direct negative) to +1 direct positive correlation. These correlations are calculated on the ABSOLUTE VALUE of the semantic differential questions (i.e. with the full scale folded in half, such that 50 now becomes 0, and the extrememe values (0, 100) become 50). The absolute value scale allows us to collapse for weak (near zero) vs. strong (near 50) signal in each variable.
2.5.2.1 node-link diagram
###################PLOT GAUSSIAN GRAPH MODEL
## get only significant correlations
m <- c # the correlation matrix
## default from easystats
# plot(m)
## 1 SIMPLY NODE NAMES
m <- as_tibble(c) %>%
mutate(
Parameter1 = str_replace_all(Parameter1, "MAKER_", "M_"),
Parameter1 = str_replace_all(Parameter1, "CHART_", "C_"),
Parameter2 = str_replace_all(Parameter2, "MAKER_", "M_"),
Parameter2 = str_replace_all(Parameter2, "CHART_", "C_")
)
## 2 SHOW ONLY SIGNIFICANT CORRELATIONS
m <- m %>%
filter(p <= 0.05)
## 3 FORMAT AS GRAPH
g <- as_tbl_graph(m)
### Gaussian Graphical Models (GGMs)
# Bhushan et al., 2019
# https://www.frontiersin.org/journals/psychology/articles/10.3389/fpsyg.2019.01050/full
# ggraph(g, layout = 'stress') +
f <-
ggraph(g, layout = 'stress') +
# ggraph(g, layout = 'linear', circular = TRUE) +
geom_edge_link(aes(colour =r,
edge_width = r,
label = round(r,2))) +
geom_node_point( size = 5) +
geom_node_label(size = 3,
# vjust = +1,
# hjust = 0.5,
repel = TRUE,
aes(label = name)) +
scale_edge_color_gradient2(low = "red",
mid = "white",
high = "blue",
midpoint = 0,
space = "Lab",
# na.value = "grey50",
guide = "edge_colourbar",
aesthetics = "edge_colour") +
theme_graph() + labs(title = "B0-0 | Significant Partial Correlations (abs value)")
f
3 WIP EXPLORATORY
3.1 TODO DATA MODELLING
4 TODO LIMITED MODELLING
4.1 FULL STIMULUS SET
4.1.1 What predicts TRUST?
design competence? data competence? chart intent? maker id?
4.1.2 What predicts BEAUTY?
4.1.3 What predicts ACTION?
4.1.4 Does MAKER ID predict MAKER POLITICS?
4.1.5 Does MAKER ID predict CHART INTENT?
4.1.6 Does MAKER AGE
TOOL ID
4.1.7 Does MAKER GENDER
anything?
- highlight maker_gender = female points in raincloud SD plots
4.1.8 DOES TOOL ID predict DATA (VS) DESIGN competence
4.1.9 DOES CHART(TYPE)
MAKER(DATA COMPETENCE)
4.1.10 DOES MAKER ID=individual imply TOOL(ID)=[simple]
4.1.11 Worth doing any stimulus abstraction category level analysis?
4.1.11.1 PREDICT more abstract corresponds with low design competence (opposite for figural)
5 TODO ARGUMENTS
5.1 TODO look for examples of inconsistent relationships between TRUST and BEAUTY
5.2 TODO look for examples of inconsistent relationships between TRUST and DATA COMPETENCE
5.3 TODO look for patterns of reversal between CHART LIKE and CHART BEAUTY
6 STASH
wip code stash
6.1 wip confidence modelling
#
# ## [test-frame] Are the confidence scores significantly different for different questions?
# ## [model-frame] Does QUESTION predict CONFIDENCE, accounting for random variance in SUBJECT and STIMULUS?
#
#
# ## MIXED model with random variance only at subject (not stimulus)
# mm1 <- lmer( CONFIDENCE ~ QUESTION + (1|PID), data = df)
# # summary(mm1)
# # plot(check_model(mm1))
# # pm <- model_parameters(mm1)
# # plot(pm, show_labels = TRUE, show_intercept = TRUE) + labs(title = "CONFIDENCE ~ QUESTION + (1|PID)")
# # performance(mm1)
# # report(mm1)
#
#
# ## MIXED model with random variance only at subject AND stimulus
# mm2 <- lmer( CONFIDENCE ~ QUESTION + (1|PID) + (1|STIMULUS), data = df)
# # summary(mm2)
# # plot(check_model(mm2))
# # pm <- model_parameters(mm2)
# # plot_model(mm2)
# # plot(pm, show_labels = TRUE, show_intercept = TRUE) + labs(title = "CONFIDENCE ~ QUESTION + (1|PID) + (1|STIMULUS)")
# # performance(mm2)
# # report(mm2)
#
#
# ## MIXED model with random slope for question by person and random intercept by stimulus
# mm3 <- lmer( CONFIDENCE ~ QUESTION + (1 + QUESTION | PID) + (1|STIMULUS), data = df)
# # summary(mm3)
# # plot(check_model(mm3))
# # pm <- model_parameters(mm3)
# # plot(pm, show_labels = TRUE, show_intercept = TRUE) + labs(title = "CONFIDENCE ~ QUESTION + (1 + QUESTION | PID) + (1|STIMULUS)")
# # performance(mm3)
# # report(mm3)
#
#
# ## MIXED model with STIMULUS as FIXED effect and random intercept by person
# mm4 <- lmer( CONFIDENCE ~ QUESTION + STIMULUS + (1 | PID), data = df)
# # summary(mm4)
# # plot(check_model(mm4))
# # pm <- model_parameters(mm4)
# # plot(pm, show_labels = TRUE, show_intercept = FALSE) + labs(title = "CONFIDENCE ~ QUESTION + STIMULUS + (1 | PID)")
# # performance(mm4)
# # report(mm4)
#
# ## MIXED model with STIMULUS * QUESTION interaction and random intercept by person
# mm5 <- lmer( CONFIDENCE ~ QUESTION * STIMULUS + (1 | PID), data = df)
# # summary(mm5)
# # plot(check_model(mm5))
# # pm <- model_parameters(mm5)
# # plot(pm, show_labels = TRUE, show_intercept = FALSE) + labs(title = "CONFIDENCE ~ QUESTION * STIMULUS + (1 | PID)")
# # performance(mm5)
# # report(mm5)
#
#
# ## MIXED model with STIMULUS * QUESTION interaction and random intercept by person
# mmx <- lmer( CONFIDENCE ~ STIMULUS + (1 | PID) + (1 | QUESTION), data = df)
# # summary(mmx)
# # plot(check_model(mmx))
# # pm <- model_parameters(mmx)
# # plot(pm, show_labels = TRUE, show_intercept = FALSE) + labs(title = "CONFIDENCE ~ STIMULUS + (1 | PID) + (1 | QUESTION)")
# # performance(mmx)
# # report(mmx)
#
#
# ### COMPARE MODELS
# # compare_parameters(mm1,mm2,mm3, mm4, mm5, mmx)
# compare_performance(mm1,mm2,mm3, mm4, mm5, mmx, rank = TRUE )
# ## model 3 is the best fit, and is appropriate to the design of the study
# summary(mm3)
# report(mm3)
# # plot_model(mm3, terms = c("QUESTION", "STIMULUS"), type = "diag")
#
# # # ## repeated measures aov
# # print("Repeated Measures ANOVA")
# # ex1 <- aov(CONFIDENCE~QUESTION+Error(PID), data=df)
# # summary(ex1)
# # report(ex1)
# 6.2 correlation plot code
# ## SHADED CIRCLES
# corrplot(m, method = 'circle', type = 'lower',
# order = 'AOE', diag = FALSE,
# insig='blank',
# tl.col = "black")
#
#
# ## SHADED NUMBERS
# corrplot(m, order = 'AOE', method = "number",
# diag = FALSE, type = "lower",
# insig='blank',
# # insig = 'label_sig', sig.level = c(0.001, 0.01, 0.05),
# addCoef.col = '#595D60',
# tl.pos = "ld", tl.col = "#595D60")
#
#
# ## SHADED SQUARED + COEFFS
# corrplot(m, order = 'AOE', method = "circle",
# diag = FALSE, type = "lower",
# insig='blank', sig.level = 0.05,
# # insig = 'label_sig', sig.level = c(0.001, 0.01, 0.05),
# addCoef.col = '#595D60',
# tl.pos = "ld", tl.col = "#595D60")
# 6.3 flip some sds
############## SETUP FOR FLIPPING SCALES ON SOME QUESTIONS TO MAKE THEM MORE READABLE
ref_sd_reordered <- c("MAKER_DATA","MAKER_DESIGN",
"CHART_BEAUTY", "CHART_LIKE",
"MAKER_POLITIC","MAKER_ARGUE", "MAKER_SELF", "CHART_INTENT",
"MAKER_ALIGN","MAKER_TRUST",
"CHART_TRUST")
left_reordered <- c("layperson","layperson",
"NOT at all","NOT at all",
"left-leaning",
"diplomatic",
"altruistic",
"inform",
"DOES share",
"untrustworthy",
"untrustworthy")
right_reordered <- c("professional","professional",
"very much", "very much",
"right-leaning",
"confrontational",
"selfish",
"persuade",
"does NOT share",
"trustworthy",
"trusthworthy")
ref_labels_reordered <- as.data.frame(cbind(left_reordered,right_reordered))
rownames(ref_labels_reordered) <- ref_sd_questions6.4 correlation matrix
## GGALLY correlation heatmap
# ggcorr(df,
# label = TRUE, geom = "tile",
# nbreaks = 5, layout.exp = 2,
# # label_round = 2,
# angle = -0, hjust = 0.8, vjust = 1, size = 2.5,
# low = "#D88585",mid = "white", high= "#6DA0D6") +
# easy_remove_legend() +
# labs(title = "Correlation between SD measures", subtitle = ("pairwise; Pearson correlations"))6.5 ridgeplot with interval and mean
# ## Does MAKER_TRUST depend on MAKER ID?
# ##RIDGEPLOT w/ MEAN
# answers <- levels(df$MAKER_ID)
# left <- rep(ref_labels['MAKER_TRUST','left'], length(levels(df$MAKER_ID)))
# right <- rep(ref_labels['MAKER_TRUST','right'], length(levels(df$MAKER_ID)))
# df %>% ggplot(aes(y = fct_rev(MAKER_ID), x= MAKER_TRUST, fill = fct_rev(MAKER_ID))) +
# geom_density_ridges(scale = 0.55,quantile_lines = TRUE, alpha = 0.75) +
# stat_dotsinterval(side = "bottom", scale = 0.7, slab_linewidth = NA, point_interval = "mean_qi") +
# stat_summary(fun=mean, geom="text", colour="blue", fontface = "bold",
# vjust=+2, hjust = 0, aes( label=round(..x.., digits=0)))+
# stat_summary(fun="mean", geom="point", shape=20, size=5, color="blue", fill="blue") +
# scale_fill_manual(values = my_palettes(name="reds", direction = "-1"), name = "", guide = guide_legend(reverse = TRUE)) +
# guides(
# y = guide_axis_manual(labels = left, title = ""),
# y.sec = guide_axis_manual(labels = right)
# ) +
# cowplot::draw_text(text = toupper(answers), x = 10, y= answers,size = 10, vjust=-2) +
# labs (title = "MAKER TRUST by MAKER ID", y = "", x = "MAKER TRUST", caption="(mean in blue)") +
# theme_minimal() + easy_remove_legend()6.6 lessR donuts
##good for seeing the color schemes
# #### DEFINE SET
# stimulus = "B2-1"
# df <- df_graphs %>% filter(STIMULUS == stimulus)
#
# #### GENERATE GRAPHS
#
# #MAKER_ID-DONUT
# PieChart(MAKER_ID, data = df,
# fill = "reds",
# main = paste0(stimulus, " MAKER ID")) + theme_minimal()
#
#
# #MAKER_GENDER-DONUT
# PieChart(MAKER_GENDER, data = df,
# fill = "blues",
# main = paste0(stimulus, " MAKER GENDER")) + theme_minimal()
#
#
# #MAKER_AGE-DONUT
# PieChart(MAKER_AGE, data = df,
# fill = "olives",
# main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
#
# #MAKER_AGE-DONUT
# PieChart(MAKER_ID, data = df,
# fill = "rusts",
# main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
#
# #MAKER_AGE-DONUT
# PieChart(MAKER_ID, data = df,
# fill = "olives",
# main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
#
# #MAKER_AGE-DONUT
# PieChart(MAKER_ID, data = df,
# fill = "greens",
# main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
#
# #MAKER_AGE-DONUT
# PieChart(MAKER_ID, data = df,
# fill = "emeralds",
# main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
#
# #MAKER_AGE-DONUT
# PieChart(MAKER_ID, data = df,
# fill = "turquoises",
# main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
#
# #MAKER_AGE-DONUT
# PieChart(MAKER_ID, data = df,
# fill = "aquas",
# main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
#
# #MAKER_AGE-MAKER_ID
# PieChart(MAKER_ID, data = df,
# fill = "purples",
# main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
#
# #MAKER_AGE-DONUT
# PieChart(MAKER_ID, data = df,
# fill = "magentas",
# main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
#
# #MAKER_AGE-DONUT
# PieChart(MAKER_ID, data = df,
# fill = "violets",
# main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
#
# #MAKER_AGE-DONUT
# PieChart(MAKER_ID, data = df,
# fill = "grays",
# main = paste0(stimulus, " MAKER AGE")) + theme_minimal()
# "reds" h 0
# "rusts" h 30
# "browns" h 60
# "olives" h 90
# "greens" h 120
# "emeralds" h 150
# "turquoises" h 180
# "aquas" h 210
# "blues" h 240
# "purples" h 270
# "violets" h 300
# "magentas" h 330
# "grays"6.7 ggplot donuts
# df <- df_graphs %>% filter(STIMULUS== s)
# #### CATEGORICAL DONUT PLOTS
# #subset data cols
# cols <- df %>% select( all_of(ref_cat_questions))
#
# ggplot( df, aes( x = STIMULUS, fill = MAKER_ID)) +
# geom_bar( position = "stack", width=1) +
# coord_radial(theta = "y", start = 0, inner.radius = 0.5, expand=FALSE) +
# scale_fill_manual(values = my_palettes(name="reds", direction = "1"), name = "", guide = guide_legend(reverse = FALSE)) +
# labs( title = paste0(s, " MAKER ID")) +
# theme_minimal()
#
# 6.8 Alluvial Plots
## EXAMPLE ALLUVIAL PLOT USING GGALUVIAL (instead of GGSANKEY)
# https://corybrunson.github.io/ggalluvial/articles/ggalluvial.html
# #FILTER FOR BLOCK 2 STIM AND RESHAPE FOR SANKEY
# ds <- df_graphs %>%
# filter(str_detect(STIMULUS, "B2")) %>%
# select(STIMULUS, MAKER_ID, PID) %>%
# mutate(
# MAKER_ID = fct_relevel(MAKER_ID,
# c("business","education","individual", "news","organization", "political" ))
# )
#
# ds %>%
# ggplot(aes( x = STIMULUS,
# stratum = MAKER_ID,
# label = MAKER_ID,
# alluvium = PID)) +
# stat_alluvium(aes(fill = MAKER_ID),
# width = 0,
# alpha = 1,
# geom = "flow")+
# geom_stratum(width = 0.2, aes(fill= MAKER_ID))+
# # geom_text(stat = "stratum", size = 5, angle = 90)+
# scale_fill_viridis(discrete=TRUE, option="viridis", drop = FALSE,
# alpha = 1) +
# theme_minimal()7 RESOURCES
- custom color palettes: https://www.r-bloggers.com/2022/06/custom-colour-palettes-for-ggplot2/
- lessR donuts https://r-charts.com/part-whole/donut-chart/
- GGSANKEY https://github.com/davidsjoberg/ggsankey
- GGALLUVIAL https://corybrunson.github.io/ggalluvial/articles/ggalluvial.html
- variable standardization [variable (vs) participant] :https://cran.r-project.org/web/packages/datawizard/vignettes/standardize_data.html
- contrasts:
- UCLA:https://stats.oarc.ucla.edu/r/library/r-library-contrast-coding-systems-for-categorical-variables
- https://phillipalday.com/stats/lazy-contrasts.html
- level naming with contrasts :https://rpubs.com/bbolker/5335